home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Source Code
/
Visual Basic Source Code.iso
/
vbsource
/
himetr1r
/
frmabout.frm
(
.txt
)
< prev
next >
Wrap
Visual Basic Form
|
1999-08-15
|
9KB
|
265 lines
VERSION 5.00
Begin VB.Form frmAbout
BackColor = &H00FFFFFF&
BorderStyle = 3 'Fixed Dialog
Caption = "About Developers Code Book"
ClientHeight = 4305
ClientLeft = 45
ClientTop = 330
ClientWidth = 5265
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmAbout.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4305
ScaleWidth = 5265
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows Default
Begin VB.Timer tmrScroll
Enabled = 0 'False
Interval = 100
Left = 120
Top = 2520
End
Begin VB.CommandButton cmdCredits
Caption = "&Credits"
Height = 375
Left = 2400
TabIndex = 5
Top = 3720
Width = 1095
End
Begin VB.CommandButton cmdOK
Caption = "&OK"
Default = -1 'True
Height = 375
Left = 3600
TabIndex = 4
Top = 3720
Width = 1215
End
Begin VB.PictureBox picCredits
BackColor = &H00FFFFFF&
Height = 1575
Left = 240
ScaleHeight = 1515
ScaleWidth = 4515
TabIndex = 6
Top = 120
Visible = 0 'False
Width = 4575
Begin VB.TextBox txtCredits
Alignment = 2 'Center
BorderStyle = 0 'None
BeginProperty Font
Name = "Tahoma"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000080FF&
Height = 1215
Left = 0
Locked = -1 'True
MultiLine = -1 'True
TabIndex = 7
Top = 120
Width = 4455
End
End
Begin VB.Shape Shape1
BorderColor = &H00FF8080&
BorderWidth = 10
Height = 1335
Left = 3360
Top = 840
Width = 1455
End
Begin VB.Image imgLogo
BorderStyle = 1 'Fixed Single
Height = 1560
Left = 240
Picture = "frmAbout.frx":014A
Top = 120
Width = 4560
End
Begin VB.Label lblEmail
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "sam@vbsquare.com"
DragIcon = "frmAbout.frx":1611C
ForeColor = &H80000007&
Height = 195
Left = 720
TabIndex = 3
Top = 3360
Width = 1455
End
Begin VB.Label lblUrl
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "http://www.www.vbsquare.com/dev/"
DragIcon = "frmAbout.frx":16426
ForeColor = &H80000007&
Height = 195
Left = 720
TabIndex = 2
Top = 3120
Width = 2730
End
Begin VB.Label lblDesc
BackStyle = 0 'Transparent
Caption = $"frmAbout.frx":16730
Height = 855
Left = 720
TabIndex = 1
Top = 2160
Width = 3615
End
Begin VB.Label lblVer
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Version 1.0.0"
BeginProperty Font
Name = "Tahoma"
Size = 14.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000080FF&
Height = 345
Left = 720
TabIndex = 0
Top = 1680
Width = 1890
End
Begin VB.Shape Shape2
BorderColor = &H00C0FFFF&
BorderWidth = 12
Height = 1215
Left = 2880
Top = 1920
Width = 1335
End
Attribute VB_Name = "frmAbout"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'----------------------------------------
'- Name: Sam Huggill
'- Email: sam@vbsquare.com
'- Web: http://www.vbsquare.com/
'- Company: Lighthouse Internet Solutions
'- Date/Time: 14/08/99 11:31:57
'----------------------------------------
'- Notes: About form
'----------------------------------------
Option Explicit
Private Sub cmdCredits_Click()
picCredits.Visible = True
DoEvents
tmrScroll.Enabled = True
End Sub
Private Sub cmdOK_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim strFile As String
Dim intFile As Integer
On Error GoTo vbErrHand
'// Show the user the current version
lblVer = "Version " & App.Major & "." & App.Minor & "." & App.Revision
CentreForm Me
lblURL.ToolTipText = lblURL.Caption
lblEmail.ToolTipText = lblEmail.Caption
intFile = FreeFile
strFile = App.Path & "\credits.txt"
If Dir$(strFile) = "" Then
Exit Sub
End If
Open strFile For Input As #intFile
txtCredits.Text = Input(LOF(intFile), intFile)
Close #intFile
txtCredits.Height = picCredits.Height * 49
Exit Sub
vbErrHand:
WriteError Err.Number, Err.Description, "frmAbout: Load", Now, App.Path & "\err.log"
MsgBox Err.Description, vbCritical + vbOKOnly, "frmAbout: Load"
End Sub
Private Sub Form_Unload(Cancel As Integer)
txtCredits.Visible = False
End Sub
Private Sub lblEmail_DragDrop(Source As Control, X As Single, Y As Single)
If Source = lblEmail Then
With lblEmail
ShellExecute 0&, vbNullString, .Caption, vbNullString, vbNullString, vbNormalFocus
.Font.Underline = False
.ForeColor = vbBlack
End With
End If
End Sub
Private Sub lblEmail_DragOver(Source As Control, X As Single, Y As Single, State As Integer)
If State = vbLeave Then
With lblEmail
.Drag vbEndDrag
.Font.Underline = False
.ForeColor = vbBlack
End With
End If
End Sub
Private Sub lblEmail_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
With lblEmail
.ForeColor = vbBlue
.Font.Underline = True
.Drag vbBeginDrag
End With
End Sub
Private Sub lblUrl_DragDrop(Source As Control, X As Single, Y As Single)
If Source Is lblURL Then
With lblURL
.Font.Underline = False
.ForeColor = vbBlack
Call ShellExecute(0&, vbNullString, .Caption, vbNullString, vbNullString, vbNormalFocus)
End With
End If
End Sub
Private Sub lblUrl_DragOver(Source As Control, X As Single, Y As Single, State As Integer)
If State = vbLeave Then
With lblURL
.Drag vbEndDrag
.Font.Underline = False
.ForeColor = vbBlack
End With
End If
End Sub
Private Sub lblUrl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
With lblURL
.ForeColor = vbBlue
.Font.Underline = True
.Drag vbBeginDrag
End With
End Sub
Private Sub tmrScroll_Timer()
If txtCredits.tOp + txtCredits.Height < picCredits.tOp Then